home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
ShareWare OnLine 2
/
ShareWare OnLine Volume 2 (CMS Software)(1993).iso
/
bbsdoors
/
multi604.zip
/
MONOMAIN.ZIP
/
MONOMAIN.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1993-01-18
|
16KB
|
483 lines
program eliminateme;
uses duree,
globvariables,
crt;
label 2,3,4,5,6,2620;
type
jeuxid=record
vainqueur:person; {person=string[61]}
gagnes:byte;
perdus:byte;
end;
var
jeuxfile:file of jeuxid;
jeuxrec:jeuxid;
dummy:integer;
monopath:string[20];
wu:text;
usernum:integer;
vide:string;
l0:integer;
line1:string;
h:text;
chemin,
logname:string[20];
numer,
status,
cumulelim,
tampax,
k:integer;
total:array[1..4] of integer;
var monobul:string;
var colorbul:string;
procedure sortdeed;
label 58,54,56;
begin
{sort deeds}
for indice8:=1 to 4 do begin
if d[indice8]<2 then goto 58;
for indice6:=1 to d[indice8]-1 do begin
for indice4:=1 to d[indice8]-1 do begin
str(papa[indice8,indice4],nom5);
str(papa[indice8,indice4+1],nom1);
if (copy(nom5,2,2)='23') or (copy(nom5,2,1)='4') then begin
val(copy(nom5,2,1),valeur,code);
indice5:=2-valeur;
goto 54;
end;
val(copy(nom5,4,2),indice5,code);
54:;
if (copy(nom1,2,2)='23') or (copy(nom1,2,1)='4') then begin
val(copy(nom1,2,1),valeur,code);
x:=2-valeur;
goto 56;
end;
val(copy(nom1,4,2),x,code);
56:;
if indice5>x then begin
indice9:=papa[indice8,indice4];
papa[indice8,indice4]:=papa[indice8,indice4+1];
papa[indice8,indice4+1]:=indice9;
end;
end;
end;
58:;
end;
end;
procedure readgame;
begin
readln(f,status); {1=Computer 2=Players-integer}
readln(f,oui); {Y=need players N=Game Filled-char}
readln(f,n); {number of players-integer}
readln(f,team); {0=no team 1=team game-integer}
readln(f,numhe); {# of hours a player can play is turn-integer}
readln(f,fastflag);{1=cards have been distributed-integer}
readln(f,tradeflag);{1=trade option is enable}
readln(f,expiration);{days when a game should be over 0=does not apply-integer}
readln(f,freepark); {1=free landing 0=no money in free landing}
readln(f,parkmoney); {amount in free landing-integer}
for i:=1 to n do begin
readln(f,names[i]); {players name-array[1..4] of string}
readln(f,password[i]);{password if any-array[1..4] of string[8]}
readln(f,l[i]); {position of player in the game-array[1..4] of integer}
readln(f,amount[i]); {total amount of money of player-array[1..4] of integer}
readln(f,d[i]); {# of properties owned-array[1..4] of integer}
readln(f,house[i]); {# of cities owned-array[1..4] of integer}
readln(f,hotel[i]); {# of capitals owned-array[1..4] of integer}
readln(f,jo[i]); {array[1..4] of integer}
readln(f,lastime[i]); {array[1..4] of string}
readln(f,lastheure[i]);{array[1..4] of integer}
readln(f,eliminate[i]);{0=in the game 1=eliminated-array[1..4] of integer}
readln(f,playteam[i]); {array[1..4] of integer-1=team one 2=team two}
for x:=1 to d[i] do begin
readln(f,buffer); {string-read the properties owned}
val(buffer,papa[i,x],code);
end;
for x:=0 to 40 do begin
readln(f,price[i,x]); {integer}
readln(f,price1[i,x]); {integer}
end;
for x:=0 to 40 do begin
readln(f,bought[i,x]); {char}
readln(f,sold[i,x]); {char}
end;
for x:=1 to 10 do begin
readln(f,transatoffer[i,x]); {integer}
readln(f,transatdemand[i,x]); {integer}
readln(f,transatbuy[i,x]); {integer}
readln(f,transatsell[i,x]); {integer}
end;
readln(f,offer[i]); {integer}
readln(f,demand[i]); {integer}
end;
end;
procedure writegame; {rewrite the game with all the modifications}
begin
writeln(f,status);
writeln(f,oui);
writeln(f,n);
writeln(f,team);
writeln(f,numhe);
writeln(f,fastflag);
writeln(f,tradeflag);
writeln(f,expiration);
writeln(f,freepark);
writeln(f,parkmoney);
for i:=1 to n do begin
writeln(f,names[i]);
writeln(f,password[i]);
writeln(f,l[i]);
writeln(f,amount[i]);
writeln(f,d[i]);
writeln(f,house[i]);
writeln(f,hotel[i]);
writeln(f,jo[i]);
writeln(f,lastime[i]);
writeln(f,lastheure[i]);
writeln(f,eliminate[i]);
writeln(f,playteam[i]);
for x:=1 to d[i] do begin
str(papa[i,x],buffer);
if length(buffer)<9 then begin {that checked a problem i used to get}
clrscr;
writeln('Problem-Contact Pierre Tavernier');
writeln('Author of multipolix-Leave message for him');
writeln('At 803-366-6235...Critical Mass BBS');
writeln(f,buffer);
close(f);
halt;
end;
writeln(f,buffer);
end;
for x:=0 to 40 do begin
writeln(f,price[i,x]);
writeln(f,price1[i,x]);
end;
for x:=0 to 40 do begin
writeln(f,bought[i,x]);
writeln(f,sold[i,x]);
end;
for x:=1 to 10 do begin
writeln(f,transatoffer[i,x]);
writeln(f,transatdemand[i,x]);
writeln(f,transatbuy[i,x]);
writeln(f,transatsell[i,x]);
end;
writeln(f,offer[i]);
writeln(f,demand[i]);
end;
end;
procedure loose(buffnom:string);
function findid(caller:person):integer; {find the id # of the player in the score.dat file}
var ind:integer; {if the player has never played his id will be 0}
begin
usernum:=0;
ind:=0;
{ reset(jeuxfile); }
if not eof(jeuxfile) then begin
repeat
ind:=ind+1;
read(jeuxfile,jeuxrec);
if jeuxrec.vainqueur=caller then usernum:=ind;
until (usernum>0) or (eof(jeuxfile));
end;
findid:=usernum;
writeln('usernum=',usernum);
end;
function nextuser:integer; {if new player, find an id for him/her}
var tempete:integer;
begin
tempete:=findid('***');
if tempete=0 then nextuser:=1+ filesize(jeuxfile) else nextuser:=tempete;
end;
procedure rout1; {this one is for new player}
begin
usernum:=nextuser;
jeuxrec.gagnes:=0;
jeuxrec.perdus:=0;
jeuxrec.vainqueur:=buffnom;
if looseflag then jeuxrec.perdus:=1
else jeuxrec.gagnes:=1;
seek(jeuxfile,usernum-1);
write(jeuxfile,jeuxrec);
end;
procedure rout2; {this one has already an id}
begin
{read(jeuxfile,jeuxrec); }
if looseflag then jeuxrec.perdus:=jeuxrec.perdus+1
else jeuxrec.gagnes:=jeuxrec.gagnes+1;
seek(jeuxfile,dummy-1);
write(jeuxfile,jeuxrec);
end;
begin
assign(jeuxfile,'score.dat');
{$I-}
reset(jeuxfile);
{$I+}
if ioresult=2 then rewrite(jeuxfile);
dummy:=findid(buffnom);
if dummy=0 then rout1;
if dummy>0 then rout2;
close(jeuxfile);
end;
procedure elimgame; {reset all variables when the player is elimnated}
begin
newxx:=41;
l[i]:=41;
jo[i]:=1000;
amount[i]:=0;
for indice6:=1 to d[i] do begin
papa[i,indice6]:=0;
end;
d[i]:=0;
indice11:=0;
indice12:=0;
eliminate[i]:=1;
sortdeed; {sort the deeds}
end;
procedure generatebulletins; {this is the part to be improved}
begin
assign(wu,monobul);
rewrite(wu);
writeln(wu,' Multipolix Hall of Fame ');
writeln(wu,' ----------------------- ');
writeln(wu,' ');
writeln(wu,'Player"s Name Games Won Games Lost');
assign(jeuxfile,'score.dat');
reset(jeuxfile);
if not eof(jeuxfile) then begin
repeat
vide:='';
read(jeuxfile,jeuxrec);
l0:=length(jeuxrec.vainqueur);
for i:=1 to 30-l0 do vide:=vide + ' ';
writeln(wu,jeuxrec.vainqueur,vide,jeuxrec.gagnes,
' ',jeuxrec.perdus);
until eof(jeuxfile);
end;
close(jeuxfile);
close(wu);
assign(wu,colorbul);
rewrite(wu);
line1:=concat(#27,'[31m',' Multipolix Hall of Fame ');
writeln(wu,line1);
writeln(wu,' ----------------------- ');
writeln(wu,' ');
line1:=concat(#27,'[32m','Player"s Name');
line1:=concat(line1,#27,'[33m',' Games Won Games Lost');
writeln(wu,line1);
reset(jeuxfile);
if not eof(jeuxfile) then begin
repeat
vide:='';
read(jeuxfile,jeuxrec);
l0:=length(jeuxrec.vainqueur);
for i:=1 to 30-l0 do vide:=vide + ' ';
writeln(wu,jeuxrec.vainqueur,vide,jeuxrec.gagnes,
' ',jeuxrec.perdus);
until eof(jeuxfile);
end;
close(wu);
close(jeuxfile);
end;
begin {main loop}
assign(h,'monomain.ctl'); {this file is edited by the sysop}
{$I-}
reset(h);
{$I+}
if ioresult =2 then begin
writeln('Monomain.ctl is missing');
halt;
end;
readln(h,numer); {# of days a game should be erased if not played}
readln(h,monobul); {name of monochrome bulletin}
readln(h,colorbul); {name of ansi bulletin}
{writeln('monobul=',monobul);
writeln('colorbul=',colorbul); this was just done for debugging}
close(h);
for k:=1 to 99 do begin {computer game loop to see if the player}
str(k,sub); {has not played during numer days}
monopath:='mono'+sub;
assign(f,monopath);
{$I-}
reset(f);
{$I+}
if ioresult=2 then goto 2;
readln(f,status);
if status<>1 then begin {status=1 for computer game}
close(f);
goto 2;
end;
readln(f,buffnom); {string-name of the player}
readln(f,laston); {string-date the game was last played}
close(f);
if daynum(date)-daynum(laston)>numer then begin
{close(f); } {eradicate the game if it has not been played}
erase(f);
end;
2:;
end;
for k:=1 to 99 do begin {players game loop to check if a player has not}
str(k,sub); {played in numer days}
monopath:='mono'+sub;
assign(f,monopath);
{$I-}
reset(f);
{$I+}
if ioresult=2 then goto 3;
readln(f,status);
if status<>2 then begin
close(f);
goto 3;
end;
close(f);
reset(f);
readgame;
close(f);
if oui='Y' then goto 3; {game still needs players-do not process}
for i:=1 to n do begin
if (daynum(date)-daynum(lastime[i]) > numer)
and (eliminate[i]=0) then begin
elimgame; {reset his/her variables}
end;
end;
rewrite(f);
writegame; {write the new modifications}
close(f);
3:;
end;
{check to see if a game is finished-That means only one player is playing}
for k:=1 to 99 do begin
str(k,sub);
monopath:='mono'+sub;
assign(f,monopath);
{$I-}
reset(f);
{$I+}
if ioresult=2 then goto 4;
for i:=1 to 4 do names[i]:='';
readln(f,status);
if status<>2 then begin {take only player games}
close(f);
goto 4;
end;
close(f);
reset(f);
readgame;
close(f);
if oui='Y' then goto 4; {still needs players-Do not process}
cumulelim:=0;
for i:=1 to n do
if eliminate[i]=0 then cumulelim:=cumulelim+1;
if cumulelim=0 then begin {means that everybody is eliminated}
erase(f);
str(k,sub);
logname:='log'+sub;
assign(u,logname);
{$I-}
erase(u); {erase the log}
{$I+}
end
else if cumulelim=1 then begin {only one player left}
for i:=1 to n do begin {let's find him}
if eliminate[i]=0 then looseflag:=true else looseflag:=false;
buffnom:=names[i];
loose(buffnom);
end;
generatebulletins;
logname:='log'+sub;
assign(u,logname);
{$I-}
erase(u); {erase the log}
{$I+}
end;
4:;
end;
for k:=1 to 99 do begin {check if the game has an epiration date}
str(k,sub);
monopath:='mono'+sub;
assign(f,monopath);
{$I-}
reset(f);
{$I+}
if ioresult=2 then goto 5;
for i:=1 to 4 do names[i]:='';
readln(f,status);
if status<>2 then begin
close(f);
goto 5;
end;
close(f);
reset(f);
readgame;
close(f);
if oui='Y' then goto 5;
for i:=1 to 4 do total[i]:=0;
if (expiration<>0) and (expiration < daynum(date)) then begin
for i:=1 to n do begin {compute the total amount of $$$}
total[i]:=amount[i]; {for each player}
if d[i]=0 then goto 6;
for k:=0 to d[i] do begin
str(papa[i,k],nom1);
val(copy(nom1,6,2),valeur,code);
total[i]:=total[i]+20*fininfo[8*valeur];
val(copy(nom1,8,1),indice2,code);
if copy(nom5,2,1)='4' then goto 6;
if copy(nom5,2,2)='23' then goto 6;
if indice2>2 then goto 2620;
val(copy(nom1,6,2),valeur,code);
total[i]:=total[i]+fininfo[8*valeur+indice2-8];
2620:;
val(copy(nom1,6,2),valeur,code);
total[i]:=total[i]+10*fininfo[8*valeur+indice2-8];
end;
6:;
end;
tampax:=total[1];
for i:=2 to n do
if total[i] > tampax then tampax:=total[i];
for i:=1 to n do
if total[i]=tampax then eliminate[i]:=0 else eliminate[i]:=1;
erase(f);
logname:='log'+sub;
assign(u,logname);
{$I-}
erase(u); {erase log}
{$I+}
for i:=1 to n do begin
if eliminate[i]=0 then looseflag:=true else looseflag:=false;
buffnom:=names[i];
loose(buffnom);
end;
generatebulletins;
end;
5:;
end;
end.